home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch6 / Compose3.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-04-27  |  8.3 KB  |  227 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form frmCompose3 
  4.    Caption         =   "Compose3 []"
  5.    ClientHeight    =   6840
  6.    ClientLeft      =   165
  7.    ClientTop       =   735
  8.    ClientWidth     =   8610
  9.    LinkTopic       =   "Form2"
  10.    ScaleHeight     =   6840
  11.    ScaleWidth      =   8610
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin MSComDlg.CommonDialog dlgOpenFile 
  14.       Left            =   0
  15.       Top             =   840
  16.       _ExtentX        =   847
  17.       _ExtentY        =   847
  18.       _Version        =   393216
  19.    End
  20.    Begin VB.PictureBox picBackground 
  21.       AutoSize        =   -1  'True
  22.       Height          =   3360
  23.       Left            =   120
  24.       Picture         =   "Compose3.frx":0000
  25.       ScaleHeight     =   220
  26.       ScaleMode       =   3  'Pixel
  27.       ScaleWidth      =   274
  28.       TabIndex        =   2
  29.       Top             =   0
  30.       Width           =   4170
  31.    End
  32.    Begin VB.PictureBox picForeground 
  33.       AutoSize        =   -1  'True
  34.       Height          =   3360
  35.       Left            =   4320
  36.       Picture         =   "Compose3.frx":2C462
  37.       ScaleHeight     =   220
  38.       ScaleMode       =   3  'Pixel
  39.       ScaleWidth      =   274
  40.       TabIndex        =   1
  41.       Top             =   0
  42.       Width           =   4170
  43.    End
  44.    Begin VB.PictureBox picResult 
  45.       Height          =   3360
  46.       Left            =   2220
  47.       ScaleHeight     =   220
  48.       ScaleMode       =   3  'Pixel
  49.       ScaleWidth      =   274
  50.       TabIndex        =   0
  51.       Top             =   3360
  52.       Width           =   4170
  53.    End
  54.    Begin VB.Menu mnuFile 
  55.       Caption         =   "&File"
  56.       Begin VB.Menu mnuFileSaveAs 
  57.          Caption         =   "Save &As..."
  58.          Shortcut        =   ^A
  59.       End
  60.    End
  61. Attribute VB_Name = "frmCompose3"
  62. Attribute VB_GlobalNameSpace = False
  63. Attribute VB_Creatable = False
  64. Attribute VB_PredeclaredId = True
  65. Attribute VB_Exposed = False
  66. Option Explicit
  67. ' Make a mask from the foreground picture.
  68. Private Sub ComposeImages()
  69. Dim background_pixels() As RGBTriplet
  70. Dim foreground_pixels() As RGBTriplet
  71. Dim result_pixels() As RGBTriplet
  72. Dim bits_per_pixel As Integer
  73. Dim transparent_r As Byte
  74. Dim transparent_g As Byte
  75. Dim transparent_b As Byte
  76. Dim is_transparent As Boolean
  77. Dim X As Integer
  78. Dim Y As Integer
  79. Dim i As Integer
  80. Dim j As Integer
  81. Dim num_transparent As Integer
  82. Dim foreground_fraction As Single
  83. Dim background_fraction As Single
  84.     ' Get the pixels from the images.
  85.     GetBitmapPixels picBackground, background_pixels, bits_per_pixel
  86.     GetBitmapPixels picForeground, foreground_pixels, bits_per_pixel
  87.     ' Allocate the result pixels.
  88.     ReDim result_pixels( _
  89.         LBound(foreground_pixels, 1) To UBound(foreground_pixels, 1), _
  90.         LBound(foreground_pixels, 2) To UBound(foreground_pixels, 2))
  91.     ' See what the upper left pixel's color is.
  92.     ' We will convert this value into white and other
  93.     ' values into black.
  94.     With foreground_pixels(0, 0)
  95.         transparent_r = .rgbRed
  96.         transparent_g = .rgbGreen
  97.         transparent_b = .rgbBlue
  98.     End With
  99.     ' Set the result color values. Skip the edges so
  100.     ' we can look at adjacent pixels.
  101.     For Y = 1 To picForeground.ScaleHeight - 2
  102.         For X = 1 To picForeground.ScaleWidth - 2
  103.             ' See if the mask pixel is transparent.
  104.             With foreground_pixels(X, Y)
  105.                 is_transparent = ( _
  106.                     (.rgbRed = transparent_r) And _
  107.                     (.rgbGreen = transparent_g) And _
  108.                     (.rgbBlue = transparent_b))
  109.             End With
  110.             If is_transparent Then
  111.                 ' The foreground pixel's transparent.
  112.                 ' Just use the background pixel color.
  113.                 With result_pixels(X, Y)
  114.                     .rgbRed = background_pixels(X, Y).rgbRed
  115.                     .rgbGreen = background_pixels(X, Y).rgbGreen
  116.                     .rgbBlue = background_pixels(X, Y).rgbBlue
  117.                 End With
  118.             Else
  119.                 ' Use a weighted average of the
  120.                 ' foreground and background pixels.
  121.                 ' See how many adjacent pixels are transparent.
  122.                 num_transparent = 0
  123.                 For i = -1 To 1
  124.                     For j = -1 To 1
  125.                         With foreground_pixels(X + i, Y + j)
  126.                             If (.rgbRed = transparent_r) And _
  127.                                (.rgbGreen = transparent_g) And _
  128.                                (.rgbBlue = transparent_b) _
  129.                             Then
  130.                                 num_transparent = num_transparent + 1
  131.                             End If
  132.                         End With
  133.                     Next j
  134.                 Next i
  135.                 ' Pick the color.
  136.                 background_fraction = num_transparent / 9#
  137.                 foreground_fraction = 1# - background_fraction
  138.                 With result_pixels(X, Y)
  139.                     .rgbRed = foreground_fraction * foreground_pixels(X, Y).rgbRed + _
  140.                               background_fraction * background_pixels(X, Y).rgbRed
  141.                     .rgbGreen = foreground_fraction * foreground_pixels(X, Y).rgbGreen + _
  142.                                 background_fraction * background_pixels(X, Y).rgbGreen
  143.                     .rgbBlue = foreground_fraction * foreground_pixels(X, Y).rgbBlue + _
  144.                                background_fraction * background_pixels(X, Y).rgbBlue
  145.                 End With
  146.             End If
  147.         Next X
  148.     Next Y
  149.     ' Copy the background edge pixels.
  150.     For Y = 0 To picForeground.ScaleHeight - 1
  151.         result_pixels(0, Y) = background_pixels(0, Y)
  152.         result_pixels(picForeground.ScaleWidth - 1, Y) = background_pixels(picForeground.ScaleWidth - 1, Y)
  153.     Next Y
  154.     For X = 0 To picForeground.ScaleWidth - 1
  155.         result_pixels(X, 0) = background_pixels(X, 0)
  156.         result_pixels(X, picForeground.ScaleHeight - 1) = background_pixels(X, picForeground.ScaleHeight - 1)
  157.     Next X
  158.     ' Set picResult's pixels.
  159.     SetBitmapPixels picResult, bits_per_pixel, result_pixels
  160.     picResult.Picture = picResult.Image
  161. End Sub
  162. ' Start in the current directory.
  163. Private Sub Form_Load()
  164. Dim ctl As Control
  165.     For Each ctl In Controls
  166.         If TypeOf ctl Is PictureBox Then
  167.             ctl.ScaleMode = vbPixels
  168.             ctl.AutoRedraw = True
  169.         End If
  170.     Next ctl
  171.     picBackground.AutoSize = True
  172.     picForeground.AutoSize = True
  173.     dlgOpenFile.CancelError = True
  174.     dlgOpenFile.InitDir = App.Path
  175.     dlgOpenFile.Filter = _
  176.         "Bitmaps (*.bmp)|*.bmp|" & _
  177.         "GIFs (*.gif)|*.gif|" & _
  178.         "JPEGs (*.jpg)|*.jpg;*.jpeg|" & _
  179.         "Icons (*.ico)|*.ico|" & _
  180.         "Cursors (*.cur)|*.cur|" & _
  181.         "Run-Length Encoded (*.rle)|*.rle|" & _
  182.         "Metafiles (*.wmf)|*.wmf|" & _
  183.         "Enhanced Metafiles (*.emf)|*.emf|" & _
  184.         "Graphic Files|*.bmp;*.gif;*.jpg;*.jpeg;*.ico;*.cur;*.rle;*.wmf;*.emf|" & _
  185.         "All Files (*.*)|*.*"
  186.     ' Make the form appear.
  187.     Show
  188.     Screen.MousePointer = vbHourglass
  189.     DoEvents
  190.     ' Compose the images.
  191.     ComposeImages
  192.     Screen.MousePointer = vbDefault
  193. End Sub
  194. ' Save the transformed image.
  195. Private Sub mnuFileSaveAs_Click()
  196. Dim file_name As String
  197.     ' Let the user select a file.
  198.     On Error Resume Next
  199.     dlgOpenFile.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly
  200.     dlgOpenFile.ShowSave
  201.     If Err.Number = cdlCancel Then
  202.         Exit Sub
  203.     ElseIf Err.Number <> 0 Then
  204.         Beep
  205.         MsgBox "Error selecting file.", , vbExclamation
  206.         Exit Sub
  207.     End If
  208.     On Error GoTo 0
  209.     Screen.MousePointer = vbHourglass
  210.     DoEvents
  211.     file_name = Trim$(dlgOpenFile.FileName)
  212.     dlgOpenFile.InitDir = Left$(file_name, Len(file_name) _
  213.         - Len(dlgOpenFile.FileTitle) - 1)
  214.     Caption = "Compose [" & dlgOpenFile.FileTitle & "]"
  215.     ' Save the transformed image into the file.
  216.     On Error GoTo SaveError
  217.     SavePicture picResult.Picture, file_name
  218.     On Error GoTo 0
  219.     Screen.MousePointer = vbDefault
  220.     Exit Sub
  221. SaveError:
  222.     Screen.MousePointer = vbDefault
  223.     MsgBox "Error " & Format$(Err.Number) & _
  224.         " saving file '" & file_name & "'" & vbCrLf & _
  225.         Err.Description
  226. End Sub
  227.